perm filename PARSE[1,LMM] blob
sn#031675 filedate 1973-03-25 generic text, type T, neo UTF8
(PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ")
T)
(LISPXPRIN1 (QUOTE "25-MAR-73 06:21:36")
T)
(LISPXTERPRI T))
(LISPXPRINT (QUOTE PARSEVARS)
T)
[RPAQQ PARSEVARS
((FNS PACKRAT PACKRAT1 PATPARSE NUMPATPARSE PATPARSE1
PATPARSE← BI12 PATPARSEAT PACKLDIFF BISET BIRPLAC)
(VARS)
(P (LOAD (QUOTE STRPOSL.COM]
(DEFINEQ
(PACKRAT
[LAMBDA N
(PROG ((CNT N)
VAL ATLST)
LP (COND
((ZEROP CNT)
(RETURN (PACKRAT1 ATLST VAL)))
((NLISTP (ARG N CNT))
(SETQ ATLST (CONS (ARG N CNT)
ATLST)))
(T (SETQ VAL (CONS (ARG N CNT)
(PACKRAT1 ATLST VAL)))
(SETQ ATLST)))
(SETQ CNT (SUB1 CNT))
(GO LP])
(PACKRAT1
[LAMBDA (ATLST LST)
(COND
(ATLST (CONS (PACK ATLST)
LST))
(T LST])
(PATPARSE
[LAMBDA (PAT)
(PROG (NUMLIST)
(* NUMLIST is a list of the #'s that have been found
-
For every # that is found, an entry is added to
NUMLIST which is (NUMBER %. Pattern where the NUMBER
occured) so that later, NUMPATPARSE can go back and
change the numbered item to
(← (## . I) item) and thus, the thing can be saved.
In MAKEMATCH, the thing-that-matched item will
either be bound to a variable, or passed along)
(SETQ PAT (PATPARSE1 (COPY PAT)))
(COND
(NUMLIST (NUMPATPARSE NUMLIST)))
(RETURN PAT])
(NUMPATPARSE
[LAMBDA (PAT NUMLIST)
(OR (NOT NUMLIST)
(HELP (QUOTE "NUMBERS NOT DONE YET")
PAT])
(PATPARSE1
[LAMBDA (PAT BACKPAT)
(* Smashes PAT with it's parsing;
BACKPAT is used when there is a ← to determine if
the previous thing was a !, a variable, or a pattern
-
If it was VAR or !, leave it alone & ignore it -
If it was a pattern, then don't PATPARSE the next
thing, since it's an EXPRESSION -
In the first two cases, BACKPAT should be T;
otherwise, it should be)
(* GODDAM IT -- THIS THING NEEDS TO DO THE RIGHT
THING WITH !←'S. I GUESS IT SHOULD BE
(!←FOO) GOES TO (!-> FOO) AND
(!VAR←) GOES TO (! ← VAR); IT COULD BE, THOUGH, THAT
ONE COULD DO (!← FOO ...) GOES TO
(! -> FOO . ...) (I.E., GLOM ONTO REST OF PATTERN) -
AND (!FOO← ...) GOES TO (! ← FOO . ...)
(DITTO) -
ANYWAY , PATPARSE DOESNT DO EITHER RIGHT NOW!!!!!!!)
(AND PAT
(PROG (TEM)
RETRY
[COND
[(NLISTP (CAR PAT))
(SELECTQ (CAR PAT)
((= == : $$)
(* Look for ←'s in (CADR PAT) and spread it out if
so -
This might want to change later -
(= foo←fie ...) -
(=foo ←fie ...) -
(=foo←fie ...) -
The second case is not ambiguous, but the first is -
it's possible to handle it just like the QUOTE -
Never split -
Or leave it to PATPARSEAT never to split after an
equal -
Also, need it for the (admittedly rare) case of #
1←foo)
(PATPARSE←
(CDR PAT)) (* And then "BI" CAR &
CDR PAT)
(BI12 PAT))
($$ (PATPARSE←
(CDR PAT))
(BI12 PAT))
[$ (PATPARSE←
(CDR PAT))
(COND
((EQ (CADR PAT)
(QUOTE 1))
(RPLACA PAT (QUOTE $1))
(RPLACD PAT (CDDR PAT)))
((SMALLP (CADR PAT))
(BI12 PAT)
(RPLACA (CAR PAT)
(QUOTE $$]
(' (* NO ←'S ALLOWED OR
CHECKED FOR)
(BI12 PAT))
((& $1 ≠1 * !) (* These are all ok -
! will be handled later)
T)
[←(COND
((NOT BACKPAT)
(PATPARSE1 (CDDR PAT))
(RETURN PAT]
(COND
((AND (STRPOSL (QUOTE (! ' ≠ & - # ←
= $ :))
(CAR PAT)
1)
(PATPARSEAT (DUNPACK (CAR PAT)
SKORLST2)
PAT))
(* Otherwise, BREAK up
CAR PAT and try to
PATPARSEAT it)
(GO RETRY))
(T (* Must have a variable
here!)
(SETQ TEM (QUOTE VAR]
((EQ (CAAR PAT)
(QUOTE ANY))
(PATPARSE1 (CDAR PAT)))
(T (* Otherwise, all there
is is a subpattern)
(PATPARSE1 (CAR PAT]
[AND (CDR PAT)
(NLISTP (CDR PAT))
(RPLACD PAT (LIST (QUOTE !)
(CDR PAT]
(PATPARSE1 (CDR PAT)
TEM)
[COND
[(EQ (CADR PAT)
(QUOTE ←))
(COND
((EQ (CAR PAT)
(QUOTE !)) (* Got (!←expr ...)
change it to
((! ← . expr) ...))
(RPLACD PAT (CDDR PAT))
(RPLACA PAT (QUOTE !->))
(BI12 PAT))
((EQ TEM (QUOTE VAR))
(* Got (VAR ← PAT ...); change it to
((← VAR . PAT) ...))
(BISET PAT))
(T
(* Otherwise, there is a (PAT ← EXPR ...); change it
to (-> expr . PAT))
(BIRPLAC PAT]
((EQ (CAR PAT)
(QUOTE !))
(BI12 PAT))
((EQ TEM (QUOTE VAR))
(RPLACA PAT (CONS (QUOTE DEFAULT)
(CAR PAT]
(RETURN PAT])
(PATPARSE←
[LAMBDA (PAT) (* Look for ←'s in
(CAR PAT))
(AND (LITATOM (CAR PAT))
(PATPARSEAT (DUNPACK (CAR PAT)
SKORLST2)
PAT
(QUOTE (←])
(BI12
[LAMBDA (PAT) (* This changes
(A B ...) to
((A . B) ...))
(COND
((OR (NLISTP PAT)
(NLISTP (CDR PAT)))
(ERROR "BAD ARG TO BI12" PAT)))
(PROG ((TEM (CDR PAT)))
(RPLACD PAT (CDDR PAT))
(RPLACD TEM (CAR TEM))
(RPLACA TEM (CAR PAT))
(RPLACA PAT TEM])
(PATPARSEAT
[LAMBDA (UNPACKEDAT PAT FLG)
(* Parses (CAR PAT) which has been unpacked into
UNPACKEDAT and replaces the parsing into
(CAR PAT); otherwise return if can't -
Unless flg is on, meaning always smash
(CAR PAT))
(PROG (TAIL AT REST)
(RETURN (COND
([SETQ TAIL
(SOME UNPACKEDAT
(FUNCTION (LAMBDA (CHR)
(FMEMB CHR
(QUOTE (' = ←
* $ # %. ! ' :]
(SETQ AT (CAR TAIL))
[SETQ REST (COND
((AND (EQ (CAR TAIL)
(QUOTE =))
(EQ (CADR TAIL)
(QUOTE =)))
(SETQ AT (QUOTE ==))
(CDDR TAIL))
([AND (EQ (CAR TAIL)
(QUOTE $))
(EQ (CADR TAIL)
1)
(NOT (SMALLP (CADDR TAIL]
(* $1's are parsed as an
atom)
(SETQ AT (QUOTE $1))
(CDDR TAIL))
((AND (EQ (CAR TAIL)
(QUOTE $))
(EQ (CADR TAIL)
(QUOTE $)))
(SETQ AT (QUOTE $$))
(CDDR TAIL))
(T (CDR TAIL]
(COND
(REST (PATPARSEAT REST PAT T)
(ATTACH AT PAT))
(T (RPLACA PAT AT)))
(AND (NOT (EQ TAIL UNPACKEDAT))
(ATTACH (PACKLDIFF UNPACKEDAT TAIL)
PAT))
PAT)
(FLG (RPLACA PAT (PACK UNPACKEDAT])
(PACKLDIFF
[LAMBDA (L TAIL)
(PROG (TEM)
(AND (SETQ TEM (NLEFT L 1 TAIL))
(RPLACD TEM)
(PROG1 (PACK L)
(RPLACD TEM TAIL])
(BISET
[LAMBDA (PAT)
(* This function changes (a b c ...) to
((b a . c) ...))
(PROG ((TEM (CDR PAT)))
(RPLACD PAT (CDDDR PAT))
(RPLACD (CDR TEM)
(CADR TEM))
(RPLACA (CDR TEM)
(CAR PAT))
(RPLACA PAT TEM])
(BIRPLAC
[LAMBDA (PAT)
(PROG ((TEM (CAR PAT)))
(RPLACA PAT (CDR PAT))
(RPLACD PAT (CDDDR PAT))
(RPLACD (CDAR PAT)
TEM)
(RPLACA (CAR PAT)
(QUOTE ->])
)
(LOAD (QUOTE STRPOSL.COM))
STOP